home *** CD-ROM | disk | FTP | other *** search
- unit Sysmet;
-
- {
- TSystemMetrics Class
- Copyright ⌐ 1995 Alan Ciemian All Rights Reserved
-
- The TSystemMetrics class acts as a wrapper to the Windows
- GetSystemMetrics function. Provides easier access and allows all the
- values to be determined once and cached for later use.
-
- This unit also creates a single TSystemMetrics object instance (SysMetrics)
- to be used globally by all units that need it.
-
- 04/26/95 - Created
- 05/01/95 - Initial Released
-
- 05/16/95 - Added GetWindowsVersion procedure.
- }
-
-
- interface
-
- uses
- WinTypes;
-
-
- type
- TSystemMetrics = class(TObject)
- private
- FBorder : TSize; { Size of a non-sizeable window border }
- FFrame : TSize; { Size of a sizeable window frame }
- FDlgFrame : TSize; { Size of a dialog frame }
- FMenuH : Integer; { Height of single-line menu - border height }
- FCaptionH : Integer; { Height of window caption + border height }
- FTitleBitmap : TSize; { Size of title bar bitmaps }
- FHScrollBtn : TSize; { Size of arrow button on horz scroll bar }
- FVScrollBtn : TSize; { Size of arrow button on vert scroll bar }
- FScrollThumb : TSize; { Size of scroll thumb, cx for horz, cy for vert }
- FFullScreenClient : TSize; { Size of client area of a full screen window }
- FMinWindow : TSize; { Minimum size of a window }
- FMinTrack : TSize; { Minimum tracking size of a window }
- FCursor : TSize; { Size of a cursor }
- FIcon : TSize; { Size of an Icon }
- FDoubleClick : TSize; { Size of rect used to determine double-clicks }
- FIconSpacing : TSize; { Size of rect used to tile icons }
- protected
- constructor Create;
- procedure CacheMetrics;
- public
- property Border: TSize read FBorder;
- property Frame: TSize read FFrame;
- property DlgFrame: TSize read FDlgFrame;
- property MenuH: Integer read FMenuH;
- property CaptionH: Integer read FCaptionH;
- property TitleBitmap: TSize read FTitleBitmap;
- property HScrollBtn: TSize read FHScrollBtn;
- property VScrollBtn: TSize read FVScrollBtn;
- property ScrollThumb: TSize read FScrollThumb;
- property FullScreenClient: TSize read FFullScreenClient;
- property MinWindow: TSize read FMinWindow;
- property MinTrack: TSize read FMinTrack;
- property Cursor: TSize read FCursor;
- property Icon: TSize read FIcon;
- property DoubleClick: TSize read FDoubleClick;
- property IconSpacing: TSize read FIconSpacing;
- end;
-
- type
- TWindowsVersion = ( osWin16, osWin95, osWinNT, osUnknown );
-
- procedure GetWindowsVersion
- (
- var Version : TWindowsVersion;
- var VerMajor : Word;
- var VerMinor : Word
- );
-
-
- var { Create an instance }
- SysMetrics : TSystemMetrics;
-
-
- implementation
-
- uses
- SysUtils,
- WinProcs;
-
-
- constructor TSystemMetrics.Create;
- begin
- inherited Create;
- CacheMetrics;
- end;
-
-
- procedure TSystemMetrics.CacheMetrics;
- begin
- FBorder.cx := GetSystemMetrics(SM_CXBORDER);
- FBorder.cy := GetSystemMetrics(SM_CYBORDER);
- FFrame.cx := GetSystemMetrics(SM_CXFRAME);
- FFrame.cy := GetSystemMetrics(SM_CYFRAME);
- FDlgFrame.cx := GetSystemMetrics(SM_CXDLGFRAME);
- FDlgFrame.cy := GetSystemMetrics(SM_CYDLGFRAME);
- FMenuH := GetSystemMetrics(SM_CYMENU);
- FCaptionH := GetSystemMetrics(SM_CYCAPTION);
- FTitleBitmap.cx := GetSystemMetrics(SM_CXSIZE);
- FTitleBitmap.cy := GetSystemMetrics(SM_CYSIZE);
- FHScrollBtn.cx := GetSystemMetrics(SM_CXHSCROLL);
- FHScrollBtn.cy := GetSystemMetrics(SM_CYHSCROLL);
- FVScrollBtn.cx := GetSystemMetrics(SM_CXVSCROLL);
- FVScrollBtn.cy := GetSystemMetrics(SM_CYVSCROLL);
- FScrollThumb.cx := GetSystemMetrics(SM_CXHTHUMB);
- FScrollThumb.cy := GetSystemMetrics(SM_CYVTHUMB);
- FFullScreenClient.cx := GetSystemMetrics(SM_CXFULLSCREEN);
- FFullScreenClient.cy := GetSystemMetrics(SM_CYFULLSCREEN);
- FMinWindow.cx := GetSystemMetrics(SM_CXMIN);
- FMinWindow.cy := GetSystemMetrics(SM_CYMIN);
- FMinTrack.cx := GetSystemMetrics(SM_CXMINTRACK);
- FMinTrack.cy := GetSystemMetrics(SM_CYMINTRACK);
- FCursor.cx := GetSystemMetrics(SM_CXCURSOR);
- FCursor.cy := GetSystemMetrics(SM_CYCURSOR);
- FIcon.cx := GetSystemMetrics(SM_CXICON);
- FIcon.cy := GetSystemMetrics(SM_CYICON);
- FDoubleClick.cx := GetSystemMetrics(SM_CXDOUBLECLK);
- FDoubleClick.cy := GetSystemMetrics(SM_CYDOUBLECLK);
- FIconSpacing.cx := GetSystemMetrics(SM_CXICONSPACING);
- FIconSpacing.cy := GetSystemMetrics(SM_CYICONSPACING);
- end;
-
-
- {
- GetWindowsVersion determines the version and version number of Windows.
- It is designed for use in a Win16 executable.
- Notes: Win16 GetVersion should never return (3 < VerMajor)
- For (VerMajor = 3), expect only (VerMinor = 0, 10)
- }
- procedure GetWindowsVersion
- (
- var Version : TWindowsVersion;
- var VerMajor : Word;
- var VerMinor : Word
- );
- var
- CodedVersion : Word;
- IsNT : Boolean;
- begin
- CodedVersion := LOWORD(GetVersion);
- VerMajor := LOBYTE(CodedVersion);
- VerMinor := HIBYTE(CodedVersion);
-
- IsNT := ( (GetWinFlags and $4000) <> 0 );
-
- if ( IsNT ) then
- begin
- Version := osWinNT;
- end
- else if ( (VerMajor < 3) or
- ((VerMajor = 3) and (VerMinor <= 10)) ) then
- begin
- Version := osWin16;
- end
- else if ( (VerMajor = 3) and (VerMinor = 95) ) then
- begin
- Version := osWin95;
- end
- else
- begin
- Version := osUnknown;
- end;
- end;
-
-
- procedure FreeSystemMetrics; far;
- begin
- SysMetrics.Free;
- end;
-
-
- initialization
-
- SysMetrics := TSystemMetrics.Create;
- AddExitProc(FreeSystemMetrics);
-
- end.
-